      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P231F91.
       AUTHOR.        B.W. MCNULTY.
       DATE-WRITTEN.  APRIL 01, 1994.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P231F91 - UNLOAD FDAT TABLES                    *
      *                                                             *
      *   SYSTEM:   FDAT - TABLE MAINTENANCE SYSTEM                 *
      *                                                             *
      *   FUNCTION: THIS PROGRAM UNLOADS THE D231 TABLES TO THE     *
      *             OLD FLAT FILE FORMAT.                           *
      *                                                             *
      *   LANGUAGE: COBOL II                                        *
      *                                                             *
      *   ENTRY:    BEGINNING OF PROGRAM                            *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      *       INPUT DB2 TABLES                                      *
      *            D231.T231DIST                                    *
      *            D231.T231DSHD                                    *
      *            D231.T231DSLN                                    *
      *            D231.T231DSBK                                    *
      *            D231.T231BOOK                                    *
      *            D231.T231RPT                                     *
      *            D231.T231COL                                     *
      *            D231.T231LINE                                    *
      *            D231.T231ORG                                     *
      *            D231.T231RGN                                     *
      *            D231.T231PRIM                                    *
      *                                                             *
      *       OUTPUT FILES - 'J231SC.FDAT.BOOK(+1)'                 *
      *                    - 'J231SC.FDAT.RPT(+1)'                  *
      *                    - 'J231SC.FDAT.COL(+1)'                  *
      *                    - 'J231SC.FDAT.LINE(+1)'                 *
      *                    - 'J231SC.FDAT.RGN(+1)'                  *
      *                    - 'J231SC.FDAT.PRIME(+1)'                *
      *                    - 'J231SC.FINRPT.DISTBL*(+1)'            *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   04/01/94  ABLMSC         ORIGINAL VERSION.                *
      *   --------  -------------  -------------------------------  *
      *                                                             *
      ***************************************************************

       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

           SELECT  TABLE-OUTPUT-FILE ASSIGN TO UT-S-OUTPUT.

       DATA DIVISION.

       FILE SECTION.

       FD  TABLE-OUTPUT-FILE
           LABEL RECORDS ARE STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           DATA RECORD IS TABLE-OUTPUT-FILE-RECORD.

       01  TABLE-OUTPUT-FILE-RECORD     PIC X(80).

           EJECT
       WORKING-STORAGE SECTION.

       01  FILLER                       PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.

       01  W0001-PROGRAM-INFO.
           05  W0001-PROGRAM-NAME       PIC X(08) VALUE 'P231F91'.
           05  CA-PARAGRAPH-NBR         PIC X(04) VALUE '0000'.

       01  W0000-MISCELLANEOUS-FIELDS.
           05  W0000-INPUT-CTR          PIC S9(09) VALUE ZERO.
           05  W0000-OUTPUT-CTR         PIC S9(09) VALUE ZERO.
           05  W0000-TOTAL-DOLLARS      PIC S9(13)V99 VALUE ZERO.
           05  W0000-OUTPUT-DISPLAY     PIC ZZZ,ZZZ,ZZ9.
           05  W0000-OUTPUT-DOLLARS     PIC ----,---,--9.99.
           05  W0000-IX                 PIC S9(09) VALUE ZERO.

           05  W0000-SEQ-NBR            PIC S9(09) VALUE ZERO.
           05  W0000-PREV-BOOK-ID       PIC  X(04) VALUE SPACES.
           05  W0000-PREV-PRIME         PIC  X(04) VALUE SPACES.
           05  W0000-PREV-LINE-CODE     PIC  X(03) VALUE SPACES.
           05  W0000-PREV-LINE-NBR      PIC  X(03) VALUE SPACES.

           05  W0000-PREV-RPT-ID        PIC  X(04) VALUE SPACES.
           05  W0000-PREV-COMMENT       PIC  X(80) VALUE SPACES.
           05  W0000-COMMENT-SWITCH     PIC  X(01) VALUE SPACES.
               88  W0000-COMMENT-FOUND             VALUE 'Y'.
               88  W0000-NO-COMMENT-FOUND          VALUE 'N'.

           05  W0000-END-OF-FILE-SW     PIC  X(01) VALUE 'N'.
               88  W0000-END-OF-FILE               VALUE 'Y'.
               88  W0000-NOT-END-OF-FILE           VALUE 'N'.

           05  W0000-PRIME-SEQ-SW       PIC  X(01) VALUE 'N'.
               88  W0000-PRIME-SEQ                 VALUE 'Y'.
               88  W0000-NOT-PRIME-SEQ             VALUE 'N'.

           EJECT
      ***************************************************************
      *    INPUT RECORD LAYOUTS                                     *
      ***************************************************************
       01  W0001-OUTPUT-RECORD                PIC X(80).

       01  W0001-T231DSLN   REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231DSLN-REC-TYPE-00.
               10  W0001-T231DSLN-COMMENT-IND PIC X(01).
                   88  W0001-T231DSLN-COMMENT-REC       VALUE '/'.
               10  W0001-T231DSLN-COMMENT     PIC X(79).

           05  W0001-T231DSLN-REC-TYPE-01     REDEFINES
               W0001-T231DSLN-REC-TYPE-00.
               10  W0001-F-DSLN-N             PIC X(03).
               10  W0001-DB-RECTYP-C          PIC X(01).
                   88  W0001-T231DSLN-REC-TYPE-1        VALUE '1'.
                   88  W0001-T231DSLN-REC-TYPE-2        VALUE '2'.
               10  W0001-F-DSID-X             PIC X(76).

           05  W0001-T231DSLN-REC-TYPE-02     REDEFINES
               W0001-T231DSLN-REC-TYPE-00.
               10  W0001-F-DSLN-N-RD          PIC X(03).
               10  W0001-DB-RECTYP-C-RD       PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-BOOKS OCCURS 9 TIMES INDEXED BY W0001-IX.
                   15  W0001-F-BKID01-C       PIC X(04).
                   15  W0001-A-CPY-N          PIC X(02).
                   15  FILLER                 PIC X(01).
                   15  FILLER                 PIC X(01).
               10  FILLER                     PIC X(03).

       01  W0001-T231BOOK   REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231BOOK-REC-TYPE-00.
               10  W0001-T231BOOK-COMMENT-IND PIC X(01).
                   88  W0001-T231BOOK-COMMENT-REC       VALUE '/'.
               10  W0001-T231BOOK-COMMENT     PIC X(79).

           05  W0001-T231BOOK-REC-TYPE-01     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C             PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-BK-RECTYP-C          PIC X(01).
                   88  W0001-T231BOOK-REC-TYPE-1        VALUE '1'.
                   88  W0001-T231BOOK-REC-TYPE-2        VALUE '2'.
                   88  W0001-T231BOOK-REC-TYPE-3        VALUE '3'.
                   88  W0001-T231BOOK-REC-TYPE-4        VALUE '4'.
                   88  W0001-T231BOOK-REC-TYPE-5        VALUE '5'.
                   88  W0001-T231BOOK-REC-TYPE-6        VALUE '6'.
               10  FILLER                     PIC X(01).
               10  W0001-F-TBL-C              PIC X(01).
               10  W0001-F-BKID-X01           PIC X(72).

           05  W0001-T231BOOK-REC-TYPE-02     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-02          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK02     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-A-PGCNT-N            PIC X(02).
               10  W0001-F-BKID-X02           PIC X(71).

           05  W0001-T231BOOK-REC-TYPE-03     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-03          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK03     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PRNT-C             PIC X(01).
               10  W0001-F-RPT01-C            PIC X(04).
               10  W0001-F-RPT02-C            PIC X(04).
               10  W0001-F-RPT03-C            PIC X(04).
               10  W0001-F-RPT04-C            PIC X(04).
               10  W0001-F-RPT05-C            PIC X(04).
               10  W0001-F-RPT06-C            PIC X(04).
               10  W0001-F-RPT07-C            PIC X(04).
               10  W0001-F-RPT08-C            PIC X(04).
               10  W0001-F-RPT09-C            PIC X(04).
               10  W0001-F-RPT10-C            PIC X(04).
               10  W0001-F-RPT11-C            PIC X(04).
               10  W0001-F-RPT12-C            PIC X(04).
               10  W0001-F-RPT13-C            PIC X(04).
               10  W0001-F-RPT14-C            PIC X(04).
               10  W0001-F-RPT15-C            PIC X(04).
               10  W0001-F-RPT16-C            PIC X(04).
               10  W0001-F-RPT17-C            PIC X(04).
               10  W0001-F-RPT18-C            PIC X(04).

           05  W0001-T231BOOK-REC-TYPE-04     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-04          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK04     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PRT-LVL-DATA.
                   15  W0001-F-PRMACCT-C01    PIC X(04).
                   15  W0001-F-PRMACCT-C02    PIC X(04).
                   15  W0001-F-PRMACCT-C03    PIC X(04).
                   15  W0001-F-PRMACCT-C04    PIC X(04).
                   15  W0001-F-PRMACCT-C05    PIC X(04).
                   15  W0001-F-PRMACCT-C06    PIC X(04).
                   15  W0001-F-PRMACCT-C07    PIC X(04).
                   15  W0001-F-PRMACCT-C08    PIC X(04).
                   15  FILLER                 PIC X(34).
               10  W0001-F-PRTLVLS            REDEFINES
                   W0001-F-PRT-LVL-DATA.
                   15  W0001-F-PRTLVL01-C1    PIC X(03).
                   15  W0001-F-PRTLVL02-C1    PIC X(03).
                   15  W0001-F-PRTLVL03-C1    PIC X(03).
                   15  W0001-F-PRTLVL04-C1    PIC X(03).
                   15  W0001-F-PRTLVL05-C1    PIC X(03).
                   15  W0001-F-PRTLVL06-C1    PIC X(03).
                   15  W0001-F-PRTLVL07-C1    PIC X(03).
                   15  W0001-F-PRTLVL08-C1    PIC X(03).
                   15  W0001-F-PRTLVL09-C1    PIC X(03).
                   15  W0001-F-PRTLVL10-C1    PIC X(03).
                   15  W0001-F-PRTLVL11-C1    PIC X(03).
                   15  W0001-F-PRTLVL01-C2    PIC X(03).
                   15  W0001-F-PRTLVL02-C2    PIC X(03).
                   15  W0001-F-PRTLVL03-C2    PIC X(03).
                   15  W0001-F-PRTLVL04-C2    PIC X(03).
                   15  W0001-F-PRTLVL05-C2    PIC X(03).
                   15  W0001-F-PRTLVL06-C2    PIC X(03).
                   15  W0001-F-PRTLVL07-C2    PIC X(03).
                   15  W0001-F-PRTLVL08-C2    PIC X(03).
                   15  W0001-F-PRTLVL09-C2    PIC X(03).
                   15  W0001-F-PRTLVL10-C2    PIC X(03).
                   15  W0001-F-PRTLVL11-C2    PIC X(03).
               10  FILLER                     PIC X(07).

           05  W0001-T231BOOK-REC-TYPE-05     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-05          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK05     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PRTSEQ01-C1        PIC X(03).
               10  W0001-F-PRTSEQ02-C1        PIC X(03).
               10  W0001-F-PRTSEQ03-C1        PIC X(03).
               10  W0001-F-PRTSEQ04-C1        PIC X(03).
               10  W0001-F-PRTSEQ05-C1        PIC X(03).
               10  W0001-F-PRTSEQ06-C1        PIC X(03).
               10  W0001-F-PRTSEQ07-C1        PIC X(03).
               10  W0001-F-PRTSEQ08-C1        PIC X(03).
               10  W0001-F-PRTSEQ09-C1        PIC X(03).
               10  W0001-F-PRTSEQ10-C1        PIC X(03).
               10  W0001-F-PRTSEQ11-C1        PIC X(03).
               10  W0001-F-PRTSEQ01-C2        PIC X(03).
               10  W0001-F-PRTSEQ02-C2        PIC X(03).
               10  W0001-F-PRTSEQ03-C2        PIC X(03).
               10  W0001-F-PRTSEQ04-C2        PIC X(03).
               10  W0001-F-PRTSEQ05-C2        PIC X(03).
               10  W0001-F-PRTSEQ06-C2        PIC X(03).
               10  W0001-F-PRTSEQ07-C2        PIC X(03).
               10  W0001-F-PRTSEQ08-C2        PIC X(03).
               10  W0001-F-PRTSEQ09-C2        PIC X(03).
               10  W0001-F-PRTSEQ10-C2        PIC X(03).
               10  W0001-F-PRTSEQ11-C2        PIC X(03).
               10  FILLER                     PIC X(07).

           05  W0001-T231BOOK-REC-TYPE-06     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-06          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK06     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-ALTSEQ01-C1        PIC X(03).
               10  W0001-F-ALTSEQ02-C1        PIC X(03).
               10  W0001-F-ALTSEQ03-C1        PIC X(03).
               10  W0001-F-ALTSEQ04-C1        PIC X(03).
               10  W0001-F-ALTSEQ05-C1        PIC X(03).
               10  W0001-F-ALTSEQ06-C1        PIC X(03).
               10  W0001-F-ALTSEQ07-C1        PIC X(03).
               10  W0001-F-ALTSEQ08-C1        PIC X(03).
               10  W0001-F-ALTSEQ09-C1        PIC X(03).
               10  W0001-F-ALTSEQ10-C1        PIC X(03).
               10  W0001-F-ALTSEQ11-C1        PIC X(03).
               10  W0001-F-ALTSEQ01-C2        PIC X(03).
               10  W0001-F-ALTSEQ02-C2        PIC X(03).
               10  W0001-F-ALTSEQ03-C2        PIC X(03).
               10  W0001-F-ALTSEQ04-C2        PIC X(03).
               10  W0001-F-ALTSEQ05-C2        PIC X(03).
               10  W0001-F-ALTSEQ06-C2        PIC X(03).
               10  W0001-F-ALTSEQ07-C2        PIC X(03).
               10  W0001-F-ALTSEQ08-C2        PIC X(03).
               10  W0001-F-ALTSEQ09-C2        PIC X(03).
               10  W0001-F-ALTSEQ10-C2        PIC X(03).
               10  W0001-F-ALTSEQ11-C2        PIC X(03).
               10  FILLER                     PIC X(07).

       01  W0001-T231RPT    REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231RPT-REC-TYPE-00.
               10  W0001-T231RPT-COMMENT-IND  PIC X(01).
                   88  W0001-T231RPT-COMMENT-REC        VALUE '/'.
               10  W0001-T231RPT-COMMENT      PIC X(79).

           05  W0001-T231RPT-REC-TYPE-01      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C            PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-RPT-RECTYP-C         PIC X(01).
                   88  W0001-T231RPT-REC-TYPE-1         VALUE '1'.
                   88  W0001-T231RPT-REC-TYPE-2         VALUE '2'.
                   88  W0001-T231RPT-REC-TYPE-3         VALUE '3'.
                   88  W0001-T231RPT-REC-TYPE-4         VALUE '4'.
                   88  W0001-T231RPT-REC-TYPE-5         VALUE '5'.
                   88  W0001-T231RPT-REC-TYPE-6         VALUE '6'.
                   88  W0001-T231RPT-REC-TYPE-7         VALUE '7'.
                   88  W0001-T231RPT-REC-TYPE-8         VALUE '8'.
               10  FILLER                     PIC X(01).
               10  W0001-F-PGBRK-C            PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTFMT-C           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-ELIM-C             PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-COLCALC-C          PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-ORG-C          PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-RGN-C          PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-LINE-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-COL-C          PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTID-X01          PIC X(51).

           05  W0001-T231RPT-REC-TYPE-02      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-02         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT02    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-PRNT-C         PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTLVL01-C         PIC X(04).
               10  W0001-F-RPTLVL02-C         PIC X(04).
               10  W0001-F-RPTLVL03-C         PIC X(04).
               10  W0001-F-RPTLVL04-C         PIC X(04).
               10  W0001-F-RPTLVL05-C         PIC X(04).
               10  W0001-F-RPTLVL06-C         PIC X(04).
               10  W0001-F-RPTLVL07-C         PIC X(04).
               10  W0001-F-RPTLVL08-C         PIC X(04).
               10  W0001-F-RPTLVL09-C         PIC X(04).
               10  W0001-F-RPTLVL10-C         PIC X(04).
               10  W0001-F-RPTLVL11-C         PIC X(04).
               10  FILLER                     PIC X(27).

           05  W0001-T231RPT-REC-TYPE-03      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-03         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT03    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-PRNT-C03       PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTSEQ01-C         PIC X(04).
               10  W0001-F-RPTSEQ02-C         PIC X(04).
               10  W0001-F-RPTSEQ03-C         PIC X(04).
               10  W0001-F-RPTSEQ04-C         PIC X(04).
               10  W0001-F-RPTSEQ05-C         PIC X(04).
               10  W0001-F-RPTSEQ06-C         PIC X(04).
               10  W0001-F-RPTSEQ07-C         PIC X(04).
               10  W0001-F-RPTSEQ08-C         PIC X(04).
               10  W0001-F-RPTSEQ09-C         PIC X(04).
               10  W0001-F-RPTSEQ10-C         PIC X(04).
               10  W0001-F-RPTSEQ11-C         PIC X(04).
               10  FILLER                     PIC X(27).

           05  W0001-T231RPT-REC-TYPE-04      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-04         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT04    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-DOLLAR-C           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD01-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD02-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD03-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD04-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD05-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD06-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD07-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD08-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD09-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD10-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD11-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD12-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD13-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD14-C             PIC X(03).
               10  FILLER                     PIC X(16).

           05  W0001-T231RPT-REC-TYPE-05      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-05         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT05    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTHDG-C           PIC X(73).

       01  W0001-T231LINE   REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231LINE-REC-TYPE-00.
               10  W0001-T231LINE-COMMENT-IND PIC X(01).
                   88  W0001-T231LINE-COMMENT-REC       VALUE '/'.
               10  W0001-T231LINE-COMMENT     PIC X(79).

           05  W0001-T231LINE-REC-TYPE-01     REDEFINES
               W0001-T231LINE-REC-TYPE-00.
               10  W0001-F-LN-C               PIC X(03).
               10  W0001-LINE-RECTYP-C        PIC X(01).
                   88  W0001-T231LINE-REC-TYPE-1  VALUES 'P', 'R', 'O'.
                   88  W0001-T231LINE-REC-TYPE-2  VALUES '0' THRU '9'.
               10  W0001-F-LINEID-X01         PIC X(76).

           05  W0001-T231LINE-REC-TYPE-02     REDEFINES
               W0001-T231LINE-REC-TYPE-00.
               10  W0001-F-LN-C-02            PIC X(03).
               10  W0001-F-LN-N               PIC X(03).
               10  W0001-F-LN-DESC            PIC X(32).
               10  W0001-F-FMTTYP-C           PIC X(01).
               10  W0001-F-CALC01-CLN         PIC X(04).
               10  W0001-F-CALC01-XLN         PIC X(01).
               10  W0001-F-CALC02-CLN         PIC X(04).
               10  W0001-F-CALC02-XLN         PIC X(01).
               10  W0001-F-CALC03-CLN         PIC X(04).
               10  W0001-F-CALC03-XLN         PIC X(01).
               10  W0001-F-CALC04-CLN         PIC X(04).
               10  W0001-F-CALC04-XLN         PIC X(01).
               10  W0001-F-CALC05-CLN         PIC X(04).
               10  W0001-F-CALC05-XLN         PIC X(01).
               10  W0001-F-CALC06-CLN         PIC X(04).
               10  W0001-F-CALC06-XLN         PIC X(01).
               10  W0001-F-CALC07-CLN         PIC X(04).
               10  W0001-F-CALC07-XLN         PIC X(01).
               10  W0001-F-CALC08-CLN         PIC X(04).
               10  W0001-F-CALC08-XLN         PIC X(01).
               10  FILLER                     PIC X(01).

       01  W0001-T231COL    REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231COL-REC-TYPE-00.
               10  W0001-T231COL-COMMENT-IND PIC X(01).
                   88  W0001-T231COL-COMMENT-REC        VALUE '/'.
               10  W0001-T231COL-COMMENT      PIC X(79).

           05  W0001-T231COL-REC-TYPE-01      REDEFINES
               W0001-T231COL-REC-TYPE-00.
               10  W0001-F-COL-C              PIC X(03).
               10  W0001-COL-RECTYP-C         PIC X(01).
                   88  W0001-T231COL-REC-TYPE-1
                                         VALUES ARE 'P', 'R', 'O', ' '.
                   88  W0001-T231COL-REC-TYPE-2
                                         VALUES ARE '0' THRU '9'.
               10  W0001-F-COLID-X01          PIC X(76).

           05  W0001-T231COL-REC-TYPE-02      REDEFINES
               W0001-T231COL-REC-TYPE-00.
               10  W0001-F-COL-C-02           PIC X(03).
               10  W0001-F-COL-N              PIC X(02).
               10  W0001-F-COL-HDG1           PIC X(09).
               10  W0001-F-COL-HDG2           PIC X(09).
               10  W0001-F-EDIT-C             PIC X(01).
               10  W0001-F-CALC01-CCOL        PIC X(04).
               10  W0001-F-CALC01-XCOL        PIC X(01).
               10  W0001-F-CALC02-CCOL        PIC X(04).
               10  W0001-F-CALC02-XCOL        PIC X(01).
               10  W0001-F-CALC03-CCOL        PIC X(04).
               10  W0001-F-CALC03-XCOL        PIC X(01).
               10  W0001-F-CALC04-CCOL        PIC X(04).
               10  W0001-F-CALC04-XCOL        PIC X(01).
               10  W0001-F-CALC05-CCOL        PIC X(04).
               10  W0001-F-CALC05-XCOL        PIC X(01).
               10  W0001-F-CALC06-CCOL        PIC X(04).
               10  W0001-F-CALC06-XCOL        PIC X(01).
               10  W0001-F-CALC07-CCOL        PIC X(04).
               10  W0001-F-CALC07-XCOL        PIC X(01).
               10  W0001-F-CALC08-CCOL        PIC X(04).
               10  W0001-F-CALC08-XCOL        PIC X(01).
               10  W0001-F-CALC09-CCOL        PIC X(04).
               10  W0001-F-CALC09-XCOL        PIC X(01).
               10  W0001-F-CALC10-CCOL        PIC X(04).
               10  W0001-F-CALC10-XCOL        PIC X(01).
               10  W0001-F-CALC11-CCOL        PIC X(04).
               10  W0001-F-CALC11-XCOL        PIC X(01).
               10  FILLER                     PIC X(01).

       01  W0001-T231PRIM   REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231PRIM-REC-TYPE-00.
               10  W0001-T231PRIM-COMMENT-IND PIC X(01).
                   88  W0001-T231PRIM-COMMENT-REC       VALUE '/'.
               10  W0001-T231PRIM-COMMENT     PIC X(79).

           05  W0001-T231PRIM-REC-TYPE-01     REDEFINES
               W0001-T231PRIM-REC-TYPE-00.
               10  W0001-F-PRMACCT-C          PIC X(04).
               10  W0001-F-FCSLN-N            PIC X(02).
               10  W0001-F-BALSHT-C           PIC X(01).
               10  W0001-F-DIVSUM-C           PIC X(01).
               10  W0001-F-PRMACCT-X          PIC X(30).
               10  W0001-CALC-AREA-01.
                   15  W0001-F-CALC01-CPRIM   PIC X(04).
                   15  W0001-F-CALC01-XPRIM   PIC X(01).
                   15  W0001-F-CALC02-CPRIM   PIC X(04).
                   15  W0001-F-CALC02-XPRIM   PIC X(01).
                   15  W0001-F-CALC03-CPRIM   PIC X(04).
                   15  W0001-F-CALC03-XPRIM   PIC X(01).
                   15  W0001-F-CALC04-CPRIM   PIC X(04).
                   15  W0001-F-CALC04-XPRIM   PIC X(01).
                   15  W0001-F-CALC05-CPRIM   PIC X(04).
                   15  W0001-F-CALC05-XPRIM   PIC X(01).
                   15  W0001-F-CALC06-CPRIM   PIC X(04).
                   15  W0001-F-CALC06-XPRIM   PIC X(01).
                   15  W0001-F-CALC07-CPRIM   PIC X(04).
                   15  W0001-F-CALC07-XPRIM   PIC X(01).
                   15  W0001-F-CALC08-CPRIM   PIC X(04).
                   15  W0001-F-CALC08-XPRIM   PIC X(01).
                   15  FILLER                 PIC X(02).
               10  W0001-CALC-AREA-02         REDEFINES
                   W0001-CALC-AREA-01.
                   15  W0001-F-PRMSUBACCT-C.
                       20  W0001-F-SUBACCT-1  PIC X(01).
                       20  W0001-F-SUBACCT-2  PIC X(01).
                       20  W0001-F-SUBACCT-3  PIC X(01).
                       20  W0001-F-SUBACCT-4  PIC X(01).
                       20  W0001-F-SUBACCT-5  PIC X(01).
                       20  W0001-F-SUBACCT-6  PIC X(01).
                       20  W0001-F-SUBACCT-7  PIC X(01).
                       20  W0001-F-SUBACCT-X  PIC X(35).

       01  W0001-T231ORG    REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231ORG-REC-TYPE-00.
               10  W0001-T231ORG-COMMENT-IND PIC X(01).
                   88  W0001-T231ORG-COMMENT-REC        VALUE '/'.
               10  W0001-T231ORG-COMMENT      PIC X(79).

           05  W0001-T231ORG-REC-TYPE-01      REDEFINES
               W0001-T231ORG-REC-TYPE-00.
               10  W0001-F-ORG-C              PIC X(02).
               10  W0001-F-ORGLVL01-C         PIC X(03).
               10  W0001-F-ORGLVL02-C         PIC X(03).
               10  W0001-F-ORGLVL03-C         PIC X(03).
               10  W0001-F-ORGLVL04-C         PIC X(03).
               10  W0001-F-ORGLVL05-C         PIC X(03).
               10  W0001-F-ORGLVL06-C         PIC X(03).
               10  W0001-F-ORGLVL07-C         PIC X(03).
               10  W0001-F-ORGLVL08-C         PIC X(03).
               10  W0001-F-ORGLVL09-C         PIC X(03).
               10  W0001-F-ORGLVL10-C         PIC X(03).
               10  W0001-F-ORGLVL11-C         PIC X(03).
               10  FILLER                     PIC X(04).
               10  W0001-F-DFLTAFM-C          PIC X(02).
               10  FILLER                     PIC X(08).
               10  W0001-F-ORG-X              PIC X(31).

           05  W0001-T231ORG-REC-TYPE-02      REDEFINES
               W0001-T231ORG-REC-TYPE-00.
               10  W0001-F-ORG-C-02           PIC X(02).
               10  W0001-F-ORGROLLUP01-C      PIC X(02).
               10  W0001-ORG-RECTYP-C         PIC X(01).
                   88  W0001-T231ORG-REC-TYPE-2         VALUE ' '.
               10  W0001-F-ORGROLLUP02-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP03-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP04-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP05-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP06-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP07-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP08-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP09-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP10-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP11-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGID-C            PIC X(04).
               10  W0001-F-ORGPRNT-C          PIC X(01).
               10  W0001-F-DIVAFM01-C         PIC X(04).
               10  W0001-F-DIVAFM02-C         PIC X(04).
               10  W0001-F-DIVAFM03-C         PIC X(04).
               10  W0001-F-ORGLN-X            PIC X(28).

       01  W0001-T231RGN    REDEFINES  W0001-OUTPUT-RECORD.

           05  W0001-T231RGN-REC-TYPE-00.
               10  W0001-T231RGN-COMMENT-IND  PIC X(01).
                   88  W0001-T231RGN-COMMENT-REC        VALUE '/'.
               10  W0001-T231RGN-COMMENT      PIC X(79).

           05  W0001-T231RGN-REC-TYPE-01      REDEFINES
               W0001-T231RGN-REC-TYPE-00.
               10  W0001-F-RGN-C              PIC X(02).
               10  W0001-F-RGNLVL01-C         PIC X(03).
               10  W0001-F-RGNLVL02-C         PIC X(03).
               10  W0001-F-RGNLVL03-C         PIC X(03).
               10  W0001-F-RGNLVL04-C         PIC X(03).
               10  W0001-F-RGNLVL05-C         PIC X(03).
               10  W0001-F-RGNLVL06-C         PIC X(03).
               10  W0001-F-RGNLVL07-C         PIC X(03).
               10  W0001-F-RGNLVL08-C         PIC X(03).
               10  FILLER                     PIC X(12).
               10  W0001-F-RGN-X              PIC X(42).

           05  W0001-T231RGN-REC-TYPE-02      REDEFINES
               W0001-T231RGN-REC-TYPE-00.
               10  W0001-F-RGN-C-02           PIC X(02).
               10  W0001-F-RGNROLLUP01-C      PIC X(02).
               10  W0001-RGN-RECTYP-C         PIC X(01).
                   88  W0001-T231RGN-REC-TYPE-2         VALUE ' '.
               10  W0001-F-RGNROLLUP02-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP03-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP04-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP05-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP06-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP07-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP08-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNID-C            PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNLOC-C           PIC X(02).
               10  W0001-F-RGNDIV-C           PIC X(02).
               10  W0001-F-RGNAFM-C           PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNLN-X            PIC X(42).

       01  W0003-COMMENT.
           05  FILLER                         PIC X(01) VALUE '/'.
           05  FILLER                         PIC X(69) VALUE SPACES.
           05  W0003-DATE                     PIC X(10) VALUE SPACES.

       01  W0004-DATE.
           05  W0004-YY                       PIC X(02) VALUE SPACES.
           05  W0004-MM                       PIC X(02) VALUE SPACES.
           05  W0004-DD                       PIC X(02) VALUE SPACES.

       01  W0005-DATE.
           05  W0005-MM                       PIC X(02) VALUE SPACES.
           05  FILLER                         PIC X(01) VALUE '/'.
           05  W0005-DD                       PIC X(02) VALUE SPACES.
           05  FILLER                         PIC X(01) VALUE '/'.
           05  W0005-YY                       PIC X(02) VALUE SPACES.


           EJECT
      ***************************************************************
      *    DB2 ERROR ROUTINE                                        *
      ***************************************************************
           COPY C108W900.

           EJECT
      ***************************************************************
      *    DB2 INCLUDE MEMBERS                                      *
      ***************************************************************
           EXEC SQL
               INCLUDE SQLCA
           END-EXEC.

           EXEC SQL
               INCLUDE T231DIST
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSHD
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSLN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSBK
           END-EXEC.

           EXEC SQL
               INCLUDE T231BOOK
           END-EXEC.

           EXEC SQL
               INCLUDE T231RPT
           END-EXEC.

           EXEC SQL
               INCLUDE T231COL
           END-EXEC.

           EXEC SQL
               INCLUDE T231LINE
           END-EXEC.

           EXEC SQL
               INCLUDE T231PRIM
           END-EXEC.

           EXEC SQL
               INCLUDE T231ORG
           END-EXEC.

           EXEC SQL
               INCLUDE T231RGN
           END-EXEC.

      ***************************************************************
      *    DB2 CURSORS                                              *
      ***************************************************************
           EXEC SQL
                DECLARE CSR_B CURSOR FOR
                 SELECT
                        F_DSID_C
                      , F_DSLN_N
                      , F_DSID_X
                   FROM D231.T231DSLN
                  WHERE F_DSID_C  = :DCLT231DSLN.F-DSID-C
                  ORDER BY
                        F_DSID_C
                      , F_DSLN_N
           END-EXEC.

           EXEC SQL
                DECLARE CSR_B1 CURSOR FOR
                 SELECT
                        F_BKID_C
                      , A_CPYP1_N
                      , A_CPYP2_N
                      , A_CPYFN_N
                      , A_CPYQ1_N
                      , A_CPYQ2_N
                      , A_CPYQ3_N
                      , A_CPYQN_N
                   FROM D231.T231DSBK
                  WHERE F_DSID_C  = :DCLT231DSBK.F-DSID-C
                    AND F_DSLN_N  = :DCLT231DSBK.F-DSLN-N
                  ORDER BY
                        F_BKID_C
           END-EXEC.

           EXEC SQL
                DECLARE CSR_C CURSOR FOR
                 SELECT
                        F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                      , F_TBL_C
                      , A_PGCNT_N
                      , F_RPT01_C
                      , F_RPT02_C
                      , F_RPT03_C
                      , F_RPT04_C
                      , F_RPT05_C
                      , F_RPT06_C
                      , F_RPT07_C
                      , F_RPT08_C
                      , F_RPT09_C
                      , F_RPT10_C
                      , F_RPT11_C
                      , F_RPT12_C
                      , F_RPT13_C
                      , F_RPT14_C
                      , F_RPT15_C
                      , F_RPT16_C
                      , F_RPT17_C
                      , F_RPT18_C
                      , F_RPT19_C
                      , F_RPT20_C
                      , F_RPT21_C
                      , F_RPT22_C
                   FROM D231.T231BOOK
                  ORDER BY
                        F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
           END-EXEC.

           EXEC SQL
                DECLARE CSR_D CURSOR FOR
                 SELECT
                        F_RPTID_C
                      , DB_RECTYP_C
                      , A_SEQ_N
                      , F_PRNT_C
                      , F_RPTFMT_C
                      , F_ELIM_C
                      , F_COLCALC_C
                      , F_ORG_C
                      , F_RGN_C
                      , F_LN_C
                      , F_COL_C
                      , F_RPTID_X
                      , F_PD01_C
                      , F_PD02_C
                      , F_PD03_C
                      , F_PD04_C
                      , F_PD05_C
                      , F_PD06_C
                      , F_PD07_C
                      , F_PD08_C
                      , F_PD09_C
                      , F_PD10_C
                      , F_PD11_C
                      , F_PD12_C
                      , F_PD13_C
                      , F_PD14_C
                   FROM D231.T231RPT
                  ORDER BY
                        F_RPTID_C
                      , DB_RECTYP_C
                      , A_SEQ_N
           END-EXEC.

           EXEC SQL
                DECLARE CSR_E CURSOR FOR
                 SELECT
                        F_LN_C
                      , F_LN_N
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_LN_X
                      , F_FMTTYP_C
                      , F_CALC01_C
                      , F_CALC02_C
                      , F_CALC03_C
                      , F_CALC04_C
                      , F_CALC05_C
                      , F_CALC06_C
                      , F_CALC07_C
                      , F_CALC08_C
                      , F_CALC01_X
                      , F_CALC02_X
                      , F_CALC03_X
                      , F_CALC04_X
                      , F_CALC05_X
                      , F_CALC06_X
                      , F_CALC07_X
                      , F_CALC08_X
                   FROM D231.T231LINE
                  ORDER BY
                        F_LN_C
                      , F_LN_N
                      , A_SEQ_N
           END-EXEC.

           EXEC SQL
                DECLARE CSR_F CURSOR FOR
                 SELECT
                        F_COL_C
                      , DB_RECTYP_C
                      , F_COL_N
                      , F_COL_X
                      , F_COLHDG1_X
                      , F_COLHDG2_X
                      , F_COLEDIT_C
                      , F_CALC01_C
                      , F_CALC02_C
                      , F_CALC03_C
                      , F_CALC04_C
                      , F_CALC05_C
                      , F_CALC06_C
                      , F_CALC07_C
                      , F_CALC08_C
                      , F_CALC09_C
                      , F_CALC10_C
                      , F_CALC11_C
                      , F_CALC01_X
                      , F_CALC02_X
                      , F_CALC03_X
                      , F_CALC04_X
                      , F_CALC05_X
                      , F_CALC06_X
                      , F_CALC07_X
                      , F_CALC08_X
                      , F_CALC09_X
                      , F_CALC10_X
                      , F_CALC11_X
                   FROM D231.T231COL
                  ORDER BY
                        F_COL_C
                      , DB_RECTYP_C
                      , F_COL_N
           END-EXEC.

           EXEC SQL
                DECLARE CSR_G CURSOR FOR
                 SELECT
                        F_PRMACCT_C
                      , DB_RECTYP_C
                      , A_SEQ_N
                      , F_FCSLN_N
                      , F_BALSHT_C
                      , F_DIVID_C
                      , F_PRMACCT_X
                      , F_PRMSUBACCT_C
                      , F_CALC01_C
                      , F_CALC02_C
                      , F_CALC03_C
                      , F_CALC04_C
                      , F_CALC05_C
                      , F_CALC06_C
                      , F_CALC07_C
                      , F_CALC08_C
                      , F_CALC01_X
                      , F_CALC02_X
                      , F_CALC03_X
                      , F_CALC04_X
                      , F_CALC05_X
                      , F_CALC06_X
                      , F_CALC07_X
                      , F_CALC08_X
                   FROM D231.T231PRIM
                  ORDER BY
      *BWM*             F_PRMACCT_C
      *BWM*           , DB_RECTYP_C
      *BWM*           , A_SEQ_N
                        A_SEQ_N
           END-EXEC.

      *BWM*
      *BWM*EXEC SQL
      *BWM*     DECLARE CSR_H CURSOR FOR
      *BWM*      SELECT
      *BWM*             F_ORG_C
      *BWM*           , DB_RECTYP_C
      *BWM*           , F_ORGLVL01_C
      *BWM*           , F_ORGLVL02_C
      *BWM*           , F_ORGLVL03_C
      *BWM*           , F_ORGLVL04_C
      *BWM*           , F_ORGLVL05_C
      *BWM*           , F_ORGLVL06_C
      *BWM*           , F_ORGLVL07_C
      *BWM*           , F_ORGLVL08_C
      *BWM*           , F_ORGLVL09_C
      *BWM*           , F_ORGLVL10_C
      *BWM*           , F_ORGLVL11_C
      *BWM*           , A_SEQ_N
      *BWM*           , F_CMNT_I
      *BWM*           , F_DFLTAFM_C
      *BWM*           , F_ORGID_C
      *BWM*           , F_PRNT_C
      *BWM*           , F_DIVAFM01_C
      *BWM*           , F_DIVAFM02_C
      *BWM*           , F_DIVAFM03_C
      *BWM*           , F_ORG_X
      *BWM*        FROM D231.T231ORG
      *BWM*       ORDER BY
      *BWM*             F_ORG_C
      *BWM*           , DB_RECTYP_C
      *BWM*           , F_ORGLVL01_C
      *BWM*           , F_ORGLVL02_C
      *BWM*           , F_ORGLVL03_C
      *BWM*           , F_ORGLVL04_C
      *BWM*           , F_ORGLVL05_C
      *BWM*           , F_ORGLVL06_C
      *BWM*           , F_ORGLVL07_C
      *BWM*           , F_ORGLVL08_C
      *BWM*           , F_ORGLVL09_C
      *BWM*           , F_ORGLVL10_C
      *BWM*           , F_ORGLVL11_C
      *BWM*           , A_SEQ_N
      *BWM*END-EXEC.
      *BWM*
           EXEC SQL
                DECLARE CSR_I CURSOR FOR
                 SELECT
                        F_RGN_C
                      , DB_RECTYP_C
                      , F_ORGLVL01_C
                      , F_ORGLVL02_C
                      , F_ORGLVL03_C
                      , F_ORGLVL04_C
                      , F_ORGLVL05_C
                      , F_ORGLVL06_C
                      , F_ORGLVL07_C
                      , F_ORGLVL08_C
                      , A_SEQ_N
                      , F_CMNT_I
                      , F_RGNID_C
                      , F_LOC_C
                      , F_DIV_C
                      , F_AFM_C
                      , F_RGN_X
                   FROM D231.T231RGN
                  ORDER BY
                        F_RGN_C
                      , DB_RECTYP_C
                      , F_ORGLVL01_C
                      , F_ORGLVL02_C  DESC
                      , F_ORGLVL03_C
                      , F_ORGLVL04_C
                      , F_ORGLVL05_C
                      , F_ORGLVL06_C
                      , F_ORGLVL07_C
                      , F_ORGLVL08_C
                      , A_SEQ_N
           END-EXEC.

           EJECT
       LINKAGE SECTION.

       01  PASSED-DATA.
           05  LINK-LENGTH                  PIC  S9(4) COMP.
           05  LINK-TABLE-NAME              PIC  X(08).
           05  LINK-PARM-SEPARATOR          PIC  X(01).
           05  LINK-DIST-ID                 PIC  X(08).

           EJECT
       PROCEDURE DIVISION USING PASSED-DATA.

       A000-MAIN-LOGIC.

           PERFORM A100-INITIALIZATION.

           PERFORM A200-PROCESS-TABLE-OUTPUT-FILE.

           PERFORM A300-TERMINATION.

           GOBACK.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100' TO CA-PARAGRAPH-NBR.

           DISPLAY ' **======================================**'.
           DISPLAY ' **  PROGRAM P231F91 - BEGIN EXECUTION   **'.
           DISPLAY ' **======================================**'.

           IF  LINK-TABLE-NAME = 'T231DIST'
               DISPLAY '    '
               DISPLAY '  EDIT REPORT FOR DIST ID: '  LINK-DIST-ID
               DISPLAY '    '
           ELSE
               DISPLAY ' #############################################'
               DISPLAY ' ## THE PASSED PARM VALUE IS: '
               DISPLAY ' ## '
               DISPLAY ' ##    TABLE NAME: '  LINK-TABLE-NAME
               DISPLAY ' ##    DIST ID   : '  LINK-DIST-ID
               DISPLAY ' ## '
               DISPLAY ' #############################################'
           END-IF.

           OPEN OUTPUT  TABLE-OUTPUT-FILE.

           ACCEPT W0004-DATE  FROM DATE.

           MOVE W0004-YY      TO W0005-YY.
           MOVE W0004-MM      TO W0005-MM.
           MOVE W0004-DD      TO W0005-DD.

           MOVE W0005-DATE    TO W0003-DATE.

           MOVE W0003-COMMENT TO W0001-OUTPUT-RECORD.
           PERFORM A210-WRITE-OUTPUT-RECORD.

           EJECT
       A200-PROCESS-TABLE-OUTPUT-FILE.

           MOVE 'A200' TO CA-PARAGRAPH-NBR.

           EVALUATE LINK-TABLE-NAME
               WHEN 'T231DIST'
                    PERFORM B000-PROCESS-T231DSLN-RECORD
               WHEN 'T231BOOK'
                    PERFORM C000-PROCESS-T231BOOK-RECORD
               WHEN 'T231RPT '
                    PERFORM D000-PROCESS-T231RPT-RECORD
               WHEN 'T231LINE'
                    PERFORM E000-PROCESS-T231LINE-RECORD
               WHEN 'T231COL '
                    PERFORM F000-PROCESS-T231COL-RECORD
               WHEN 'T231PRIM'
                    PERFORM G000-PROCESS-T231PRIM-RECORD
               WHEN 'T231ORG '
                    PERFORM H000-PROCESS-T231ORG-RECORD
               WHEN 'T231RGN '
                    PERFORM I000-PROCESS-T231RGN-RECORD
               WHEN OTHER
                    DISPLAY ' ###################################'
                    DISPLAY ' ##  INVALID PARM VALUE RECEIVED  ##'
                    DISPLAY ' ###################################'
                    SET W0000-END-OF-FILE TO TRUE
                    MOVE +666             TO RETURN-CODE
           END-EVALUATE.

           EJECT
       A210-WRITE-OUTPUT-RECORD.

           MOVE 'A210' TO CA-PARAGRAPH-NBR.

           WRITE TABLE-OUTPUT-FILE-RECORD FROM W0001-OUTPUT-RECORD.

      *BWM*DISPLAY ' OUTPUT=' W0001-T231DSLN.
           ADD +1 TO W0000-OUTPUT-CTR.

           EJECT
       A300-TERMINATION.

           MOVE 'A300' TO CA-PARAGRAPH-NBR.

           CLOSE TABLE-OUTPUT-FILE.

           MOVE W0000-INPUT-CTR  TO W0000-OUTPUT-DISPLAY.
           DISPLAY '  # OF RECORDS READ   :' W0000-OUTPUT-DISPLAY.

           MOVE W0000-OUTPUT-CTR TO W0000-OUTPUT-DISPLAY.
           DISPLAY '  # OF RECORDS WRITTEN:' W0000-OUTPUT-DISPLAY.

           DISPLAY ' **======================================**'.
           DISPLAY ' **  PROGRAM P231F91 - END EXECUTION     **'.
           DISPLAY ' **======================================**'.

           EJECT
       B000-PROCESS-T231DSLN-RECORD.

           MOVE 'B000' TO CA-PARAGRAPH-NBR.

           IF  LINK-DIST-ID (5:2) = 'AX'
               MOVE LINK-DIST-ID (1:4) TO F-DSID-C IN DCLT231DSLN
               MOVE LINK-DIST-ID (7:2) TO F-DSID-C IN DCLT231DSLN (5:2)
           ELSE
               MOVE LINK-DIST-ID (1:6) TO F-DSID-C IN DCLT231DSLN
           END-IF.

           DISPLAY ' **--------------------------------------**'.
           DISPLAY '   DISTRIBUTION ID: ' F-DSID-C IN DCLT231DSLN.
           DISPLAY ' **--------------------------------------**'.

           PERFORM B100-BUILD-COMMENT-REC.

           EXEC SQL
                OPEN CSR_B
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_B
                     INTO :DCLT231DSLN.F-DSID-C
                        , :DCLT231DSLN.F-DSLN-N
                        , :DCLT231DSLN.F-DSID-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0001-OUTPUT-RECORD

                   PERFORM B200-BUILD-REC-TYPE-1

                   PERFORM B300-BUILD-REC-TYPE-2

                   IF  W0001-IX > +1
                   OR  W0000-IX = +1
                       PERFORM A210-WRITE-OUTPUT-RECORD
                       ADD +1 TO W0000-INPUT-CTR
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_B
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       B100-BUILD-COMMENT-REC.

           MOVE 'B100' TO CA-PARAGRAPH-NBR.

           MOVE '/'
             TO W0001-T231DSLN-COMMENT-IND.
           MOVE LINK-DIST-ID
             TO W0001-T231DSLN-COMMENT.

           PERFORM A210-WRITE-OUTPUT-RECORD.

           EJECT
       B200-BUILD-REC-TYPE-1.

           MOVE 'B200' TO CA-PARAGRAPH-NBR.

           MOVE F-DSLN-N          IN DCLT231DSLN
             TO W0001-F-DSLN-N.
           MOVE '1'
             TO W0001-DB-RECTYP-C.
           MOVE F-DSID-X          IN DCLT231DSLN
             TO W0001-F-DSID-X.

           PERFORM A210-WRITE-OUTPUT-RECORD.

           EJECT
       B300-BUILD-REC-TYPE-2.

           MOVE 'B300' TO CA-PARAGRAPH-NBR.

           MOVE F-DSID-C          IN DCLT231DSLN
             TO F-DSID-C          IN DCLT231DSBK.
           MOVE F-DSLN-N          IN DCLT231DSLN
             TO F-DSLN-N          IN DCLT231DSBK.

           MOVE +1 TO W0000-IX.

           SET W0001-IX TO +1.

           INITIALIZE W0001-OUTPUT-RECORD.

           MOVE F-DSLN-N          IN DCLT231DSLN
             TO W0001-F-DSLN-N.
           MOVE '2'
             TO W0001-DB-RECTYP-C.

           EXEC SQL
                OPEN CSR_B1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_B1
                     INTO :DCLT231DSBK.F-BKID-C
                        , :DCLT231DSBK.A-CPYP1-N
                        , :DCLT231DSBK.A-CPYP2-N
                        , :DCLT231DSBK.A-CPYFN-N
                        , :DCLT231DSBK.A-CPYQ1-N
                        , :DCLT231DSBK.A-CPYQ2-N
                        , :DCLT231DSBK.A-CPYQ3-N
                        , :DCLT231DSBK.A-CPYQN-N
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   EVALUATE TRUE
                       WHEN LINK-DIST-ID (7:2) = 'P1'
                            MOVE A-CPYP1-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                       WHEN LINK-DIST-ID (7:2) = 'P2'
                            MOVE A-CPYP2-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                       WHEN LINK-DIST-ID (7:2) = 'FN'
                            MOVE A-CPYFN-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                       WHEN LINK-DIST-ID (7:2) = 'Q1'
                            MOVE A-CPYQ1-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                       WHEN LINK-DIST-ID (7:2) = 'Q2'
                            MOVE A-CPYQ2-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                       WHEN LINK-DIST-ID (7:2) = 'Q3'
                            MOVE A-CPYQ3-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                       WHEN LINK-DIST-ID (7:2) = 'QN'
                            MOVE A-CPYQN-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                       WHEN OTHER
                            MOVE A-CPYP1-N  IN DCLT231DSBK
                              TO W0001-A-CPY-N (W0001-IX)
                   END-EVALUATE

                   IF  W0001-A-CPY-N (W0001-IX) > '  '
                       MOVE F-BKID-C         IN DCLT231DSBK
                         TO W0001-F-BKID01-C (W0001-IX)
                       SET W0001-IX UP BY +1
                       ADD +1 TO W0000-IX
                   END-IF

                   IF  W0001-IX > +9
                       PERFORM A210-WRITE-OUTPUT-RECORD
                       SET W0001-IX TO +1

                       INITIALIZE W0001-OUTPUT-RECORD

                       MOVE F-DSLN-N          IN DCLT231DSLN
                         TO W0001-F-DSLN-N
                       MOVE '2'
                         TO W0001-DB-RECTYP-C
                   END-IF

                   ADD +1 TO W0000-INPUT-CTR
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_B1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       C000-PROCESS-T231BOOK-RECORD.

           MOVE 'C000' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_C
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_C
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0001-OUTPUT-RECORD

                   EVALUATE TRUE
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '/'
                            PERFORM C100-BUILD-COMMENT-REC
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '1'
                            PERFORM C200-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '2'
                            PERFORM C300-BUILD-REC-TYPE-2
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '3'
                            PERFORM C400-BUILD-REC-TYPE-3
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '4'
                            PERFORM C500-BUILD-REC-TYPE-4
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '5'
                            PERFORM C600-BUILD-REC-TYPE-5
                       WHEN DB-RECTYP-C  IN DCLT231BOOK   = '6'
                            PERFORM C700-BUILD-REC-TYPE-6
                   END-EVALUATE

                   PERFORM A210-WRITE-OUTPUT-RECORD
                   ADD +1 TO W0000-INPUT-CTR
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_C
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       C100-BUILD-COMMENT-REC.

           MOVE 'C100' TO CA-PARAGRAPH-NBR.

           MOVE '/'
             TO W0001-T231BOOK-COMMENT-IND.
           MOVE F-BKID-X          IN DCLT231BOOK
             TO W0001-T231BOOK-COMMENT.

           EJECT
       C200-BUILD-REC-TYPE-1.

           MOVE 'C200' TO CA-PARAGRAPH-NBR.

           MOVE F-BKID-C          IN DCLT231BOOK
             TO W0001-F-BKID-C.
           MOVE DB-RECTYP-C       IN DCLT231BOOK
             TO W0001-BK-RECTYP-C.
           MOVE F-TBL-C           IN DCLT231BOOK
             TO W0001-F-TBL-C.
           MOVE F-BKID-X          IN DCLT231BOOK
             TO W0001-F-BKID-X01.

           EJECT
       C300-BUILD-REC-TYPE-2.

           MOVE 'C300' TO CA-PARAGRAPH-NBR.

           MOVE F-BKID-C          IN DCLT231BOOK
             TO W0001-F-BKID-C.
           MOVE DB-RECTYP-C       IN DCLT231BOOK
             TO W0001-BK-RECTYP-C.
           MOVE F-BKID-X          IN DCLT231BOOK
             TO W0001-F-BKID-X02.
           MOVE A-PGCNT-N         IN DCLT231BOOK
             TO W0001-A-PGCNT-N.

           EJECT
       C400-BUILD-REC-TYPE-3.

           MOVE 'C400' TO CA-PARAGRAPH-NBR.

           MOVE F-BKID-C          IN DCLT231BOOK
             TO W0001-F-BKID-C.
           MOVE DB-RECTYP-C       IN DCLT231BOOK
             TO W0001-BK-RECTYP-C.
           MOVE F-TBL-C           IN DCLT231BOOK
             TO W0001-F-PRNT-C.
           MOVE F-RPT01-C         IN DCLT231BOOK
             TO W0001-F-RPT01-C.
           MOVE F-RPT02-C         IN DCLT231BOOK
             TO W0001-F-RPT02-C.
           MOVE F-RPT03-C         IN DCLT231BOOK
             TO W0001-F-RPT03-C.
           MOVE F-RPT04-C         IN DCLT231BOOK
             TO W0001-F-RPT04-C.
           MOVE F-RPT05-C         IN DCLT231BOOK
             TO W0001-F-RPT05-C.
           MOVE F-RPT06-C         IN DCLT231BOOK
             TO W0001-F-RPT06-C.
           MOVE F-RPT07-C         IN DCLT231BOOK
             TO W0001-F-RPT07-C.
           MOVE F-RPT08-C         IN DCLT231BOOK
             TO W0001-F-RPT08-C.
           MOVE F-RPT09-C         IN DCLT231BOOK
             TO W0001-F-RPT09-C.
           MOVE F-RPT10-C         IN DCLT231BOOK
             TO W0001-F-RPT10-C.
           MOVE F-RPT11-C         IN DCLT231BOOK
             TO W0001-F-RPT11-C.
           MOVE F-RPT12-C         IN DCLT231BOOK
             TO W0001-F-RPT12-C.
           MOVE F-RPT13-C         IN DCLT231BOOK
             TO W0001-F-RPT13-C.
           MOVE F-RPT14-C         IN DCLT231BOOK
             TO W0001-F-RPT14-C.
           MOVE F-RPT15-C         IN DCLT231BOOK
             TO W0001-F-RPT15-C.
           MOVE F-RPT16-C         IN DCLT231BOOK
             TO W0001-F-RPT16-C.
           MOVE F-RPT17-C         IN DCLT231BOOK
             TO W0001-F-RPT17-C.
           MOVE F-RPT18-C         IN DCLT231BOOK
             TO W0001-F-RPT18-C.

           EJECT
       C500-BUILD-REC-TYPE-4.

           MOVE 'C500' TO CA-PARAGRAPH-NBR.

           MOVE F-BKID-C          IN DCLT231BOOK
             TO W0001-F-BKID-C.
           MOVE DB-RECTYP-C       IN DCLT231BOOK
             TO W0001-BK-RECTYP-C.

           IF  F-RPT01-C  IN DCLT231BOOK NOT EQUAL 'TOT '
               SET W0000-PRIME-SEQ TO TRUE
               MOVE F-RPT01-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C01
               MOVE F-RPT02-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C02
               MOVE F-RPT03-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C03
               MOVE F-RPT04-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C04
               MOVE F-RPT05-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C05
               MOVE F-RPT06-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C06
               MOVE F-RPT07-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C07
               MOVE F-RPT08-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C08
           ELSE
               SET W0000-NOT-PRIME-SEQ TO TRUE
               MOVE F-RPT01-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL01-C1
               MOVE F-RPT02-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL02-C1
               MOVE F-RPT03-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL03-C1
               MOVE F-RPT04-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL04-C1
               MOVE F-RPT05-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL05-C1
               MOVE F-RPT06-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL06-C1
               MOVE F-RPT07-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL07-C1
               MOVE F-RPT08-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL08-C1
               MOVE F-RPT09-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL09-C1
               MOVE F-RPT10-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL10-C1
               MOVE F-RPT11-C         IN DCLT231BOOK
                 TO W0001-F-PRTLVL11-C1
           END-IF.

           MOVE F-RPT12-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL01-C2.
           MOVE F-RPT13-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL02-C2.
           MOVE F-RPT14-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL03-C2.
           MOVE F-RPT15-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL04-C2.
           MOVE F-RPT16-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL05-C2.
           MOVE F-RPT17-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL06-C2.
           MOVE F-RPT18-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL07-C2.
           MOVE F-RPT19-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL08-C2.
           MOVE F-RPT20-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL09-C2.
           MOVE F-RPT21-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL10-C2.
           MOVE F-RPT22-C         IN DCLT231BOOK
             TO W0001-F-PRTLVL11-C2.

           EJECT
       C600-BUILD-REC-TYPE-5.

           MOVE 'C600' TO CA-PARAGRAPH-NBR.

           MOVE F-BKID-C          IN DCLT231BOOK
             TO W0001-F-BKID-C
           MOVE DB-RECTYP-C       IN DCLT231BOOK
             TO W0001-BK-RECTYP-C

           IF  W0000-PRIME-SEQ
               MOVE F-RPT01-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C01
               MOVE F-RPT02-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C02
               MOVE F-RPT03-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C03
               MOVE F-RPT04-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C04
               MOVE F-RPT05-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C05
               MOVE F-RPT06-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C06
               MOVE F-RPT07-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C07
               MOVE F-RPT08-C         IN DCLT231BOOK
                 TO W0001-F-PRMACCT-C08
           ELSE
               MOVE F-RPT01-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ01-C1
               MOVE F-RPT02-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ02-C1
               MOVE F-RPT03-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ03-C1
               MOVE F-RPT04-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ04-C1
               MOVE F-RPT05-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ05-C1
               MOVE F-RPT06-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ06-C1
               MOVE F-RPT07-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ07-C1
               MOVE F-RPT08-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ08-C1
               MOVE F-RPT09-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ09-C1
               MOVE F-RPT10-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ10-C1
               MOVE F-RPT11-C         IN DCLT231BOOK
                 TO W0001-F-PRTSEQ11-C1
           END-IF.

           MOVE F-RPT12-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ01-C2.
           MOVE F-RPT13-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ02-C2.
           MOVE F-RPT14-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ03-C2.
           MOVE F-RPT15-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ04-C2.
           MOVE F-RPT16-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ05-C2.
           MOVE F-RPT17-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ06-C2.
           MOVE F-RPT18-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ07-C2.
           MOVE F-RPT19-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ08-C2.
           MOVE F-RPT20-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ09-C2.
           MOVE F-RPT21-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ10-C2.
           MOVE F-RPT22-C         IN DCLT231BOOK
             TO W0001-F-PRTSEQ11-C2.

           EJECT
       C700-BUILD-REC-TYPE-6.

           MOVE 'C700' TO CA-PARAGRAPH-NBR.

           MOVE F-BKID-C          IN DCLT231BOOK
             TO W0001-F-BKID-C.
           MOVE DB-RECTYP-C       IN DCLT231BOOK
             TO W0001-BK-RECTYP-C.

           MOVE F-RPT01-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ01-C1.
           MOVE F-RPT02-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ02-C1.
           MOVE F-RPT03-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ03-C1.
           MOVE F-RPT04-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ04-C1.
           MOVE F-RPT05-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ05-C1.
           MOVE F-RPT06-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ06-C1.
           MOVE F-RPT07-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ07-C1.
           MOVE F-RPT08-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ08-C1.
           MOVE F-RPT09-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ09-C1.
           MOVE F-RPT10-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ10-C1.
           MOVE F-RPT11-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ11-C1.

           MOVE F-RPT12-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ01-C2.
           MOVE F-RPT13-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ02-C2.
           MOVE F-RPT14-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ03-C2.
           MOVE F-RPT15-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ04-C2.
           MOVE F-RPT16-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ05-C2.
           MOVE F-RPT17-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ06-C2.
           MOVE F-RPT18-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ07-C2.
           MOVE F-RPT19-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ08-C2.
           MOVE F-RPT20-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ09-C2.
           MOVE F-RPT21-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ10-C2.
           MOVE F-RPT22-C         IN DCLT231BOOK
             TO W0001-F-ALTSEQ11-C2.

           EJECT
       D000-PROCESS-T231RPT-RECORD.

           MOVE 'D000' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_D
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_D
                     INTO :DCLT231RPT.F-RPTID-C
                        , :DCLT231RPT.DB-RECTYP-C
                        , :DCLT231RPT.A-SEQ-N
                        , :DCLT231RPT.F-PRNT-C
                        , :DCLT231RPT.F-RPTFMT-C
                        , :DCLT231RPT.F-ELIM-C
                        , :DCLT231RPT.F-COLCALC-C
                        , :DCLT231RPT.F-ORG-C
                        , :DCLT231RPT.F-RGN-C
                        , :DCLT231RPT.F-LN-C
                        , :DCLT231RPT.F-COL-C
                        , :DCLT231RPT.F-RPTID-X
                        , :DCLT231RPT.F-PD01-C
                        , :DCLT231RPT.F-PD02-C
                        , :DCLT231RPT.F-PD03-C
                        , :DCLT231RPT.F-PD04-C
                        , :DCLT231RPT.F-PD05-C
                        , :DCLT231RPT.F-PD06-C
                        , :DCLT231RPT.F-PD07-C
                        , :DCLT231RPT.F-PD08-C
                        , :DCLT231RPT.F-PD09-C
                        , :DCLT231RPT.F-PD10-C
                        , :DCLT231RPT.F-PD11-C
                        , :DCLT231RPT.F-PD12-C
                        , :DCLT231RPT.F-PD13-C
                        , :DCLT231RPT.F-PD14-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0001-OUTPUT-RECORD

                   EVALUATE TRUE
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '/'
                            PERFORM D100-BUILD-COMMENT-REC
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '1'
                            PERFORM D200-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '2'
                            PERFORM D300-BUILD-REC-TYPE-2
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '3'
                            PERFORM D400-BUILD-REC-TYPE-3
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '4'
                            PERFORM D500-BUILD-REC-TYPE-4
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '5'
                            PERFORM D600-BUILD-REC-TYPE-5
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '6'
                            PERFORM D600-BUILD-REC-TYPE-5
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '7'
                            PERFORM D600-BUILD-REC-TYPE-5
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '8'
                            PERFORM D600-BUILD-REC-TYPE-5
                   END-EVALUATE

                   PERFORM A210-WRITE-OUTPUT-RECORD
                   ADD +1 TO W0000-INPUT-CTR
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_D
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.


           EJECT
       D100-BUILD-COMMENT-REC.

           MOVE 'D100' TO CA-PARAGRAPH-NBR.

           MOVE '/'
             TO W0001-T231RPT-COMMENT-IND.
           MOVE F-RPTID-X         IN DCLT231RPT
             TO W0001-T231RPT-COMMENT.

           EJECT
       D200-BUILD-REC-TYPE-1.

           MOVE 'D200' TO CA-PARAGRAPH-NBR.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO W0001-F-RPTID-C.
           MOVE DB-RECTYP-C       IN DCLT231RPT
             TO W0001-RPT-RECTYP-C.
           MOVE F-PRNT-C          IN DCLT231RPT
             TO W0001-F-PGBRK-C.
           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO W0001-F-RPTFMT-C.
           MOVE F-ELIM-C          IN DCLT231RPT
             TO W0001-F-ELIM-C.
           MOVE F-COLCALC-C       IN DCLT231RPT
             TO W0001-F-COLCALC-C.
           MOVE F-ORG-C           IN DCLT231RPT
             TO W0001-F-RPT-ORG-C.
           MOVE F-RGN-C           IN DCLT231RPT
             TO W0001-F-RPT-RGN-C.
           MOVE F-LN-C            IN DCLT231RPT
             TO W0001-F-RPT-LINE-C.
           MOVE F-COL-C           IN DCLT231RPT
             TO W0001-F-RPT-COL-C.
           MOVE F-RPTID-X         IN DCLT231RPT
             TO W0001-F-RPTID-X01.

           EJECT
       D300-BUILD-REC-TYPE-2.

           MOVE 'D300' TO CA-PARAGRAPH-NBR.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO W0001-F-RPTID-C.
           MOVE DB-RECTYP-C       IN DCLT231RPT
             TO W0001-RPT-RECTYP-C.
           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO W0001-F-RPT-PRNT-C.
           MOVE F-PD01-C          IN DCLT231RPT
             TO W0001-F-RPTLVL01-C.
           MOVE F-PD02-C          IN DCLT231RPT
             TO W0001-F-RPTLVL02-C.
           MOVE F-PD03-C          IN DCLT231RPT
             TO W0001-F-RPTLVL03-C.
           MOVE F-PD04-C          IN DCLT231RPT
             TO W0001-F-RPTLVL04-C.
           MOVE F-PD05-C          IN DCLT231RPT
             TO W0001-F-RPTLVL05-C.
           MOVE F-PD06-C          IN DCLT231RPT
             TO W0001-F-RPTLVL06-C.
           MOVE F-PD07-C          IN DCLT231RPT
             TO W0001-F-RPTLVL07-C.
           MOVE F-PD08-C          IN DCLT231RPT
             TO W0001-F-RPTLVL08-C.
           MOVE F-PD09-C          IN DCLT231RPT
             TO W0001-F-RPTLVL09-C.
           MOVE F-PD10-C          IN DCLT231RPT
             TO W0001-F-RPTLVL10-C.
           MOVE F-PD11-C          IN DCLT231RPT
             TO W0001-F-RPTLVL11-C.

           EJECT
       D400-BUILD-REC-TYPE-3.

           MOVE 'D400' TO CA-PARAGRAPH-NBR.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO W0001-F-RPTID-C.
           MOVE DB-RECTYP-C       IN DCLT231RPT
             TO W0001-RPT-RECTYP-C.
           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO W0001-F-RPT-PRNT-C03.
           MOVE F-PD01-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ01-C.
           MOVE F-PD02-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ02-C.
           MOVE F-PD03-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ03-C.
           MOVE F-PD04-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ04-C.
           MOVE F-PD05-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ05-C.
           MOVE F-PD06-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ06-C.
           MOVE F-PD07-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ07-C.
           MOVE F-PD08-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ08-C.
           MOVE F-PD09-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ09-C.
           MOVE F-PD10-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ10-C.
           MOVE F-PD11-C          IN DCLT231RPT
             TO W0001-F-RPTSEQ11-C.

           EJECT
       D500-BUILD-REC-TYPE-4.

           MOVE 'D500' TO CA-PARAGRAPH-NBR.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO W0001-F-RPTID-C.
           MOVE DB-RECTYP-C       IN DCLT231RPT
             TO W0001-RPT-RECTYP-C.

           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO W0001-F-DOLLAR-C.
           MOVE F-PD01-C          IN DCLT231RPT
             TO W0001-F-PD01-C.
           MOVE F-PD02-C          IN DCLT231RPT
             TO W0001-F-PD02-C.
           MOVE F-PD03-C          IN DCLT231RPT
             TO W0001-F-PD03-C.
           MOVE F-PD04-C          IN DCLT231RPT
             TO W0001-F-PD04-C.
           MOVE F-PD05-C          IN DCLT231RPT
             TO W0001-F-PD05-C.
           MOVE F-PD06-C          IN DCLT231RPT
             TO W0001-F-PD06-C.
           MOVE F-PD07-C          IN DCLT231RPT
             TO W0001-F-PD07-C.
           MOVE F-PD08-C          IN DCLT231RPT
             TO W0001-F-PD08-C.
           MOVE F-PD09-C          IN DCLT231RPT
             TO W0001-F-PD09-C.
           MOVE F-PD10-C          IN DCLT231RPT
             TO W0001-F-PD10-C.
           MOVE F-PD11-C          IN DCLT231RPT
             TO W0001-F-PD11-C.
           MOVE F-PD12-C          IN DCLT231RPT
             TO W0001-F-PD12-C.
           MOVE F-PD13-C          IN DCLT231RPT
             TO W0001-F-PD13-C.
           MOVE F-PD14-C          IN DCLT231RPT
             TO W0001-F-PD14-C.

           EJECT
       D600-BUILD-REC-TYPE-5.

           MOVE 'D600' TO CA-PARAGRAPH-NBR.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO W0001-F-RPTID-C.
           MOVE DB-RECTYP-C       IN DCLT231RPT
             TO W0001-RPT-RECTYP-C.

           MOVE F-RPTID-X         IN DCLT231RPT
             TO W0001-F-RPTHDG-C.

           EJECT
       E000-PROCESS-T231LINE-RECORD.

           MOVE 'E000' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_E
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_E
                     INTO :DCLT231LINE.F-LN-C
                        , :DCLT231LINE.F-LN-N
                        , :DCLT231LINE.A-SEQ-N
                        , :DCLT231LINE.DB-RECTYP-C
                        , :DCLT231LINE.F-LN-X
                        , :DCLT231LINE.F-FMTTYP-C
                        , :DCLT231LINE.F-CALC01-C
                        , :DCLT231LINE.F-CALC02-C
                        , :DCLT231LINE.F-CALC03-C
                        , :DCLT231LINE.F-CALC04-C
                        , :DCLT231LINE.F-CALC05-C
                        , :DCLT231LINE.F-CALC06-C
                        , :DCLT231LINE.F-CALC07-C
                        , :DCLT231LINE.F-CALC08-C
                        , :DCLT231LINE.F-CALC01-X
                        , :DCLT231LINE.F-CALC02-X
                        , :DCLT231LINE.F-CALC03-X
                        , :DCLT231LINE.F-CALC04-X
                        , :DCLT231LINE.F-CALC05-X
                        , :DCLT231LINE.F-CALC06-X
                        , :DCLT231LINE.F-CALC07-X
                        , :DCLT231LINE.F-CALC08-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0001-OUTPUT-RECORD

                   EVALUATE TRUE
                       WHEN DB-RECTYP-C  IN DCLT231LINE   = '/'
                            PERFORM E100-BUILD-COMMENT-REC
                       WHEN DB-RECTYP-C  IN DCLT231LINE   = 'P'
                            PERFORM E200-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231LINE   = 'R'
                            PERFORM E200-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231LINE   = 'O'
                            PERFORM E200-BUILD-REC-TYPE-1
                       WHEN OTHER
                            PERFORM E300-BUILD-REC-TYPE-2
                   END-EVALUATE

                   PERFORM A210-WRITE-OUTPUT-RECORD
                   ADD +1 TO W0000-INPUT-CTR
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_E
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       E100-BUILD-COMMENT-REC.

           MOVE 'E100' TO CA-PARAGRAPH-NBR.

           MOVE '/'
             TO W0001-T231LINE-COMMENT-IND.
           MOVE F-LN-X            IN DCLT231LINE
             TO W0001-T231LINE-COMMENT.

           EJECT
       E200-BUILD-REC-TYPE-1.

           MOVE 'E200' TO CA-PARAGRAPH-NBR.

           MOVE F-LN-C            IN DCLT231LINE
             TO W0001-F-LN-C.
           MOVE DB-RECTYP-C       IN DCLT231LINE
             TO W0001-LINE-RECTYP-C.
           MOVE F-LN-X            IN DCLT231LINE
             TO W0001-F-LINEID-X01.

           MOVE F-LN-C            IN DCLT231LINE
             TO W0000-PREV-LINE-CODE.
           MOVE SPACES
             TO W0000-PREV-LINE-NBR.

           EJECT
       E300-BUILD-REC-TYPE-2.

           MOVE 'E300' TO CA-PARAGRAPH-NBR.

           MOVE F-LN-C            IN DCLT231LINE
             TO W0001-F-LN-C.

           IF  F-LN-N IN DCLT231LINE = W0000-PREV-LINE-NBR
               MOVE SPACES
                 TO W0001-F-LN-N
           ELSE
               MOVE F-LN-N        IN DCLT231LINE
                 TO W0001-F-LN-N
           END-IF.

           MOVE F-LN-X            IN DCLT231LINE
             TO W0001-F-LN-DESC.
           MOVE F-FMTTYP-C        IN DCLT231LINE
             TO W0001-F-FMTTYP-C.
           MOVE F-CALC01-C        IN DCLT231LINE
             TO W0001-F-CALC01-CLN.
           MOVE F-CALC02-C        IN DCLT231LINE
             TO W0001-F-CALC02-CLN.
           MOVE F-CALC03-C        IN DCLT231LINE
             TO W0001-F-CALC03-CLN.
           MOVE F-CALC04-C        IN DCLT231LINE
             TO W0001-F-CALC04-CLN.
           MOVE F-CALC05-C        IN DCLT231LINE
             TO W0001-F-CALC05-CLN.
           MOVE F-CALC06-C        IN DCLT231LINE
             TO W0001-F-CALC06-CLN.
           MOVE F-CALC07-C        IN DCLT231LINE
             TO W0001-F-CALC07-CLN.
           MOVE F-CALC08-C        IN DCLT231LINE
             TO W0001-F-CALC08-CLN.
           MOVE F-CALC01-X        IN DCLT231LINE
             TO W0001-F-CALC01-XLN.
           MOVE F-CALC02-X        IN DCLT231LINE
             TO W0001-F-CALC02-XLN.
           MOVE F-CALC03-X        IN DCLT231LINE
             TO W0001-F-CALC03-XLN.
           MOVE F-CALC04-X        IN DCLT231LINE
             TO W0001-F-CALC04-XLN.
           MOVE F-CALC05-X        IN DCLT231LINE
             TO W0001-F-CALC05-XLN.
           MOVE F-CALC06-X        IN DCLT231LINE
             TO W0001-F-CALC06-XLN.
           MOVE F-CALC07-X        IN DCLT231LINE
             TO W0001-F-CALC07-XLN.
           MOVE F-CALC08-X        IN DCLT231LINE
             TO W0001-F-CALC08-XLN.

           MOVE F-LN-N            IN DCLT231LINE
             TO W0000-PREV-LINE-NBR.

           EJECT
       F000-PROCESS-T231COL-RECORD.

           MOVE 'F000' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_F
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_F
                     INTO :DCLT231COL.F-COL-C
                        , :DCLT231COL.DB-RECTYP-C
                        , :DCLT231COL.F-COL-N
                        , :DCLT231COL.F-COL-X
                        , :DCLT231COL.F-COLHDG1-X
                        , :DCLT231COL.F-COLHDG2-X
                        , :DCLT231COL.F-COLEDIT-C
                        , :DCLT231COL.F-CALC01-C
                        , :DCLT231COL.F-CALC02-C
                        , :DCLT231COL.F-CALC03-C
                        , :DCLT231COL.F-CALC04-C
                        , :DCLT231COL.F-CALC05-C
                        , :DCLT231COL.F-CALC06-C
                        , :DCLT231COL.F-CALC07-C
                        , :DCLT231COL.F-CALC08-C
                        , :DCLT231COL.F-CALC09-C
                        , :DCLT231COL.F-CALC10-C
                        , :DCLT231COL.F-CALC11-C
                        , :DCLT231COL.F-CALC01-X
                        , :DCLT231COL.F-CALC02-X
                        , :DCLT231COL.F-CALC03-X
                        , :DCLT231COL.F-CALC04-X
                        , :DCLT231COL.F-CALC05-X
                        , :DCLT231COL.F-CALC06-X
                        , :DCLT231COL.F-CALC07-X
                        , :DCLT231COL.F-CALC08-X
                        , :DCLT231COL.F-CALC09-X
                        , :DCLT231COL.F-CALC10-X
                        , :DCLT231COL.F-CALC11-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0001-OUTPUT-RECORD

                   EVALUATE TRUE
                       WHEN DB-RECTYP-C  IN DCLT231COL    = '/'
                            PERFORM F100-BUILD-COMMENT-REC
                       WHEN DB-RECTYP-C  IN DCLT231COL    = '1'
                            PERFORM F200-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231COL    = '2'
                            PERFORM F300-BUILD-REC-TYPE-2
                   END-EVALUATE

                   PERFORM A210-WRITE-OUTPUT-RECORD
                   ADD +1 TO W0000-INPUT-CTR
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_F
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       F100-BUILD-COMMENT-REC.

           MOVE 'F100' TO CA-PARAGRAPH-NBR.

           MOVE '/'
             TO W0001-T231COL-COMMENT-IND.
           MOVE F-COL-X           IN DCLT231COL
             TO W0001-T231COL-COMMENT.

           EJECT
       F200-BUILD-REC-TYPE-1.

           MOVE 'F200' TO CA-PARAGRAPH-NBR.

           MOVE F-COL-C           IN DCLT231COL
             TO W0001-F-COL-C.
           MOVE F-COL-N           IN DCLT231COL
             TO W0001-COL-RECTYP-C.
           MOVE F-COL-X           IN DCLT231COL
             TO W0001-F-COLID-X01.

           EJECT
       F300-BUILD-REC-TYPE-2.

           MOVE 'F300' TO CA-PARAGRAPH-NBR.

           MOVE F-COL-C           IN DCLT231COL
             TO W0001-F-COL-C.
           MOVE F-COL-N           IN DCLT231COL
             TO W0001-F-COL-N.

           MOVE F-COLHDG1-X       IN DCLT231COL
             TO W0001-F-COL-HDG1.
           MOVE F-COLHDG2-X       IN DCLT231COL
             TO W0001-F-COL-HDG2.
           MOVE F-COLEDIT-C       IN DCLT231COL
             TO W0001-F-EDIT-C.

           MOVE F-CALC01-C        IN DCLT231COL
             TO W0001-F-CALC01-CCOL.
           MOVE F-CALC02-C        IN DCLT231COL
             TO W0001-F-CALC02-CCOL.
           MOVE F-CALC03-C        IN DCLT231COL
             TO W0001-F-CALC03-CCOL.
           MOVE F-CALC04-C        IN DCLT231COL
             TO W0001-F-CALC04-CCOL.
           MOVE F-CALC05-C        IN DCLT231COL
             TO W0001-F-CALC05-CCOL.
           MOVE F-CALC06-C        IN DCLT231COL
             TO W0001-F-CALC06-CCOL.
           MOVE F-CALC07-C        IN DCLT231COL
             TO W0001-F-CALC07-CCOL.
           MOVE F-CALC08-C        IN DCLT231COL
             TO W0001-F-CALC08-CCOL.
           MOVE F-CALC09-C        IN DCLT231COL
             TO W0001-F-CALC09-CCOL.
           MOVE F-CALC10-C        IN DCLT231COL
             TO W0001-F-CALC10-CCOL.
           MOVE F-CALC11-C        IN DCLT231COL
             TO W0001-F-CALC11-CCOL.
           MOVE F-CALC01-X        IN DCLT231COL
             TO W0001-F-CALC01-XCOL.
           MOVE F-CALC02-X        IN DCLT231COL
             TO W0001-F-CALC02-XCOL.
           MOVE F-CALC03-X        IN DCLT231COL
             TO W0001-F-CALC03-XCOL.
           MOVE F-CALC04-X        IN DCLT231COL
             TO W0001-F-CALC04-XCOL.
           MOVE F-CALC05-X        IN DCLT231COL
             TO W0001-F-CALC05-XCOL.
           MOVE F-CALC06-X        IN DCLT231COL
             TO W0001-F-CALC06-XCOL.
           MOVE F-CALC07-X        IN DCLT231COL
             TO W0001-F-CALC07-XCOL.
           MOVE F-CALC08-X        IN DCLT231COL
             TO W0001-F-CALC08-XCOL.
           MOVE F-CALC09-X        IN DCLT231COL
             TO W0001-F-CALC09-XCOL.
           MOVE F-CALC10-X        IN DCLT231COL
             TO W0001-F-CALC10-XCOL.
           MOVE F-CALC11-X        IN DCLT231COL
             TO W0001-F-CALC11-XCOL.

           EJECT
       G000-PROCESS-T231PRIM-RECORD.

           MOVE 'G000' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_G
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_G
                     INTO :DCLT231PRIM.F-PRMACCT-C
                        , :DCLT231PRIM.DB-RECTYP-C
                        , :DCLT231PRIM.A-SEQ-N
                        , :DCLT231PRIM.F-FCSLN-N
                        , :DCLT231PRIM.F-BALSHT-C
                        , :DCLT231PRIM.F-DIVID-C
                        , :DCLT231PRIM.F-PRMACCT-X
                        , :DCLT231PRIM.F-PRMSUBACCT-C
                        , :DCLT231PRIM.F-CALC01-C
                        , :DCLT231PRIM.F-CALC02-C
                        , :DCLT231PRIM.F-CALC03-C
                        , :DCLT231PRIM.F-CALC04-C
                        , :DCLT231PRIM.F-CALC05-C
                        , :DCLT231PRIM.F-CALC06-C
                        , :DCLT231PRIM.F-CALC07-C
                        , :DCLT231PRIM.F-CALC08-C
                        , :DCLT231PRIM.F-CALC01-X
                        , :DCLT231PRIM.F-CALC02-X
                        , :DCLT231PRIM.F-CALC03-X
                        , :DCLT231PRIM.F-CALC04-X
                        , :DCLT231PRIM.F-CALC05-X
                        , :DCLT231PRIM.F-CALC06-X
                        , :DCLT231PRIM.F-CALC07-X
                        , :DCLT231PRIM.F-CALC08-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0001-OUTPUT-RECORD

                   EVALUATE TRUE
                       WHEN DB-RECTYP-C  IN DCLT231PRIM   = '/'
                            PERFORM G100-BUILD-COMMENT-REC
                       WHEN OTHER
                            PERFORM G200-BUILD-REC-TYPE-1
                   END-EVALUATE

                   PERFORM A210-WRITE-OUTPUT-RECORD
                   ADD +1 TO W0000-INPUT-CTR
                   IF  F-PRMACCT-C IN DCLT231PRIM > SPACES
                       MOVE F-PRMACCT-C IN DCLT231PRIM
                         TO W0000-PREV-PRIME
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_G
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       G100-BUILD-COMMENT-REC.

           MOVE 'G100' TO CA-PARAGRAPH-NBR.

           MOVE '/'
             TO W0001-T231PRIM-COMMENT-IND.
           MOVE F-PRMACCT-X       IN DCLT231PRIM
             TO W0001-T231PRIM-COMMENT.

           EJECT
       G200-BUILD-REC-TYPE-1.

           MOVE 'G200' TO CA-PARAGRAPH-NBR.

           IF  F-PRMACCT-C IN DCLT231PRIM = W0000-PREV-PRIME
               MOVE SPACES
                 TO W0001-F-PRMACCT-C
           ELSE
               MOVE F-PRMACCT-C       IN DCLT231PRIM
                 TO W0001-F-PRMACCT-C
           END-IF.

           MOVE F-FCSLN-N         IN DCLT231PRIM
             TO W0001-F-FCSLN-N.
           MOVE F-BALSHT-C        IN DCLT231PRIM
             TO W0001-F-BALSHT-C.
           MOVE F-DIVID-C         IN DCLT231PRIM
             TO W0001-F-DIVSUM-C.
           MOVE F-PRMACCT-X       IN DCLT231PRIM
             TO W0001-F-PRMACCT-X.

           IF  F-PRMSUBACCT-C    IN DCLT231PRIM NOT EQUAL SPACES
               MOVE F-PRMSUBACCT-C    IN DCLT231PRIM
                 TO W0001-F-PRMSUBACCT-C
           ELSE
               MOVE F-CALC01-C        IN DCLT231PRIM
                 TO W0001-F-CALC01-CPRIM
               MOVE F-CALC02-C        IN DCLT231PRIM
                 TO W0001-F-CALC02-CPRIM
               MOVE F-CALC03-C        IN DCLT231PRIM
                 TO W0001-F-CALC03-CPRIM
               MOVE F-CALC04-C        IN DCLT231PRIM
                 TO W0001-F-CALC04-CPRIM
               MOVE F-CALC05-C        IN DCLT231PRIM
                 TO W0001-F-CALC05-CPRIM
               MOVE F-CALC06-C        IN DCLT231PRIM
                 TO W0001-F-CALC06-CPRIM
               MOVE F-CALC07-C        IN DCLT231PRIM
                 TO W0001-F-CALC07-CPRIM
               MOVE F-CALC08-C        IN DCLT231PRIM
                 TO W0001-F-CALC08-CPRIM
               MOVE F-CALC01-X        IN DCLT231PRIM
                 TO W0001-F-CALC01-XPRIM
               MOVE F-CALC02-X        IN DCLT231PRIM
                 TO W0001-F-CALC02-XPRIM
               MOVE F-CALC03-X        IN DCLT231PRIM
                 TO W0001-F-CALC03-XPRIM
               MOVE F-CALC04-X        IN DCLT231PRIM
                 TO W0001-F-CALC04-XPRIM
               MOVE F- ALC05-X        IN DCLT231PRIM
                 TO W0001-F-CALC05-XPRIM
               MOVE F-CALC06-X        IN DCLT231PRIM
                 TO W0001-F-CALC06-XPRIM
               MOVE F-CALC07-X        IN DCLT231PRIM
                 TO W0001-F-CALC07-XPRIM
               MOVE F-CALC08-X        IN DCLT231PRIM
                 TO W0001-F-CALC08-XPRIM
           END-IF.

           EJECT
       H000-PROCESS-T231ORG-RECORD.

           MOVE 'H000' TO CA-PARAGRAPH-NBR.

      *BWM*EXEC SQL
      *BWM*     OPEN CSR_H
      *BWM*END-EXEC.
      *BWM*
      *BWM*SET OPEN-O-CLOSE-CURSOR TO TRUE.
      *BWM*PERFORM Z900-DB2-CHECK.
      *BWM*
      *BWM*PERFORM UNTIL SQLCODE NOT EQUAL ZERO
      *BWM*
      *BWM*    EXEC SQL
      *BWM*         FETCH CSR_H
      *BWM*          INTO :DCLT231ORG.F-ORG-C
      *BWM*             , :DCLT231ORG.DB-RECTYP-C
      *BWM*             , :DCLT231ORG.F-ORGLVL01-C
      *BWM*             , :DCLT231ORG.F-ORGLVL02-C
      *BWM*             , :DCLT231ORG.F-ORGLVL03-C
      *BWM*             , :DCLT231ORG.F-ORGLVL04-C
      *BWM*             , :DCLT231ORG.F-ORGLVL05-C
      *BWM*             , :DCLT231ORG.F-ORGLVL06-C
      *BWM*             , :DCLT231ORG.F-ORGLVL07-C
      *BWM*             , :DCLT231ORG.F-ORGLVL08-C
      *BWM*             , :DCLT231ORG.F-ORGLVL09-C
      *BWM*             , :DCLT231ORG.F-ORGLVL10-C
      *BWM*             , :DCLT231ORG.F-ORGLVL11-C
      *BWM*             , :DCLT231ORG.A-SEQ-N
      *BWM*             , :DCLT231ORG.F-CMNT-I
      *BWM*             , :DCLT231ORG.F-DFLTAFM-C
      *BWM*             , :DCLT231ORG.F-ORGID-C
      *BWM*             , :DCLT231ORG.F-PRNT-C
      *BWM*             , :DCLT231ORG.F-DIVAFM01-C
      *BWM*             , :DCLT231ORG.F-DIVAFM02-C
      *BWM*             , :DCLT231ORG.F-DIVAFM03-C
      *BWM*             , :DCLT231ORG.F-ORG-X
      *BWM*    END-EXEC
      *BWM*
      *BWM*    PERFORM Z900-DB2-CHECK
      *BWM*
      *BWM*    IF  DB2-NORMAL
      *BWM*        INITIALIZE W0001-OUTPUT-RECORD
      *BWM*
      *BWM*        EVALUATE TRUE
      *BWM*            WHEN F-CMNT-I     IN DCLT231ORG    = '/'
      *BWM*                 PERFORM H100-BUILD-COMMENT-REC
      *BWM*            WHEN DB-RECTYP-C  IN DCLT231ORG    = '1'
      *BWM*                 PERFORM H200-BUILD-REC-TYPE-1
      *BWM*            WHEN DB-RECTYP-C  IN DCLT231ORG    = '2'
      *BWM*                 PERFORM H300-BUILD-REC-TYPE-2
      *BWM*        END-EVALUATE
      *BWM*
      *BWM*        PERFORM A210-WRITE-OUTPUT-RECORD
      *BWM*        ADD +1 TO W0000-INPUT-CTR
      *BWM*    END-IF
      *BWM*END-PERFORM.
      *BWM*
      *BWM*EXEC SQL
      *BWM*    CLOSE CSR_H
      *BWM*END-EXEC.
      *BWM*
      *BWM*SET OPEN-O-CLOSE-CURSOR TO TRUE.
      *BWM*PERFORM Z900-DB2-CHECK.
      *BWM*
      *BWM*EJECT
      *H100-BUILD-COMMENT-REC.
      *BWM*
      *BWM*MOVE 'H100' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*MOVE '/'
      *BWM*  TO W0001-T231ORG-COMMENT-IND.
      *BWM*MOVE F-ORG-X           IN DCLT231ORG
      *BWM*  TO W0001-T231ORG-COMMENT.
      *BWM*
      *BWM*EJECT
      *H200-BUILD-REC-TYPE-1.
      *BWM*
      *BWM*MOVE 'H200' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*MOVE F-ORG-C           IN DCLT231ORG
      *BWM*  TO W0001-F-ORG-C.
      *BWM*MOVE F-ORGLVL01-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL01-C.
      *BWM*MOVE F-ORGLVL02-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL02-C.
      *BWM*MOVE F-ORGLVL03-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL03-C.
      *BWM*MOVE F-ORGLVL04-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL04-C.
      *BWM*MOVE F-ORGLVL05-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL05-C.
      *BWM*MOVE F-ORGLVL06-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL06-C.
      *BWM*MOVE F-ORGLVL07-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL07-C.
      *BWM*MOVE F-ORGLVL08-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL08-C.
      *BWM*MOVE F-ORGLVL09-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL09-C.
      *BWM*MOVE F-ORGLVL10-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL10-C.
      *BWM*MOVE F-ORGLVL11-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLVL11-C.
      *BWM*
      *BWM*MOVE F-DFLTAFM-C       IN DCLT231ORG
      *BWM*  TO W0001-F-DFLTAFM-C.
      *BWM*MOVE F-ORG-X           IN DCLT231ORG
      *BWM*  TO W0001-F-ORG-X.
      *BWM*
      *BWM*EJECT
      *H300-BUILD-REC-TYPE-2.
      *BWM*
      *BWM*MOVE 'H300' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*MOVE F-ORG-C           IN DCLT231ORG
      *BWM*  TO W0001-F-ORG-C.
      *BWM*MOVE F-ORGLVL01-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP01-C.
      *BWM*MOVE F-ORGLVL02-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP02-C.
      *BWM*MOVE F-ORGLVL03-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP03-C.
      *BWM*MOVE F-ORGLVL04-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP04-C.
      *BWM*MOVE F-ORGLVL05-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP05-C.
      *BWM*MOVE F-ORGLVL06-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP06-C.
      *BWM*MOVE F-ORGLVL07-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP07-C.
      *BWM*MOVE F-ORGLVL08-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP08-C.
      *BWM*MOVE F-ORGLVL09-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP09-C.
      *BWM*MOVE F-ORGLVL10-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP10-C.
      *BWM*MOVE F-ORGLVL11-C      IN DCLT231ORG
      *BWM*  TO W0001-F-ORGROLLUP11-C.
      *BWM*
      *BWM*MOVE F-ORGID-C         IN DCLT231ORG
      *BWM*  TO W0001-F-ORGID-C.
      *BWM*MOVE F-PRNT-C          IN DCLT231ORG
      *BWM*  TO W0001-F-ORGPRNT-C.
      *BWM*MOVE F-DIVAFM01-C      IN DCLT231ORG
      *BWM*  TO W0001-F-DIVAFM01-C.
      *BWM*MOVE F-DIVAFM02-C      IN DCLT231ORG
      *BWM*  TO W0001-F-DIVAFM02-C.
      *BWM*MOVE F-DIVAFM03-C      IN DCLT231ORG
      *BWM*  TO W0001-F-DIVAFM03-C.
      *BWM*MOVE F-ORG-X           IN DCLT231ORG
      *BWM*  TO W0001-F-ORGLN-X.
      *BWM*
           EJECT
       I000-PROCESS-T231RGN-RECORD.

           MOVE 'I000' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_I
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_I
                     INTO :DCLT231RGN.F-RGN-C
                        , :DCLT231RGN.DB-RECTYP-C
                        , :DCLT231RGN.F-ORGLVL01-C
                        , :DCLT231RGN.F-ORGLVL02-C
                        , :DCLT231RGN.F-ORGLVL03-C
                        , :DCLT231RGN.F-ORGLVL04-C
                        , :DCLT231RGN.F-ORGLVL05-C
                        , :DCLT231RGN.F-ORGLVL06-C
                        , :DCLT231RGN.F-ORGLVL07-C
                        , :DCLT231RGN.F-ORGLVL08-C
                        , :DCLT231RGN.A-SEQ-N
                        , :DCLT231RGN.F-CMNT-I
                        , :DCLT231RGN.F-RGNID-C
                        , :DCLT231RGN.F-LOC-C
                        , :DCLT231RGN.F-DIV-C
                        , :DCLT231RGN.F-AFM-C
                        , :DCLT231RGN.F-RGN-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0001-OUTPUT-RECORD

                   EVALUATE TRUE
                       WHEN F-CMNT-I     IN DCLT231RGN    = '/'
                            PERFORM I100-BUILD-COMMENT-REC
                       WHEN DB-RECTYP-C  IN DCLT231RGN    = '1'
                            PERFORM I200-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231RGN    = '2'
                            PERFORM I300-BUILD-REC-TYPE-2
                   END-EVALUATE

                   PERFORM A210-WRITE-OUTPUT-RECORD
                   ADD +1 TO W0000-INPUT-CTR
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_I
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       I100-BUILD-COMMENT-REC.

           MOVE 'I100' TO CA-PARAGRAPH-NBR.

           MOVE '/'
             TO W0001-T231RGN-COMMENT-IND.
           MOVE F-RGN-X           IN DCLT231RGN
             TO W0001-T231RGN-COMMENT.

           EJECT
       I200-BUILD-REC-TYPE-1.

           MOVE 'I200' TO CA-PARAGRAPH-NBR.

           MOVE F-RGN-C           IN DCLT231RGN
             TO W0001-F-RGN-C.
           MOVE F-ORGLVL01-C      IN DCLT231RGN
             TO W0001-F-RGNLVL01-C.
           MOVE F-ORGLVL02-C      IN DCLT231RGN
             TO W0001-F-RGNLVL02-C.
           MOVE F-ORGLVL03-C      IN DCLT231RGN
             TO W0001-F-RGNLVL03-C.
           MOVE F-ORGLVL04-C      IN DCLT231RGN
             TO W0001-F-RGNLVL04-C.
           MOVE F-ORGLVL05-C      IN DCLT231RGN
             TO W0001-F-RGNLVL05-C.
           MOVE F-ORGLVL06-C      IN DCLT231RGN
             TO W0001-F-RGNLVL06-C.
           MOVE F-ORGLVL07-C      IN DCLT231RGN
             TO W0001-F-RGNLVL07-C.
           MOVE F-ORGLVL08-C      IN DCLT231RGN
             TO W0001-F-RGNLVL08-C.

           MOVE F-RGN-X           IN DCLT231RGN
             TO W0001-F-RGN-X.

           EJECT
       I300-BUILD-REC-TYPE-2.

           MOVE 'I300' TO CA-PARAGRAPH-NBR.

           MOVE F-RGN-C           IN DCLT231RGN
             TO W0001-F-RGN-C.
           MOVE F-ORGLVL01-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP01-C.
           MOVE F-ORGLVL02-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP02-C.
           MOVE F-ORGLVL03-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP03-C.
           MOVE F-ORGLVL04-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP04-C.
           MOVE F-ORGLVL05-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP05-C.
           MOVE F-ORGLVL06-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP06-C.
           MOVE F-ORGLVL07-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP07-C.
           MOVE F-ORGLVL08-C      IN DCLT231RGN
             TO W0001-F-RGNROLLUP08-C.

           MOVE F-RGNID-C         IN DCLT231RGN
             TO W0001-F-RGNID-C.
           MOVE F-LOC-C           IN DCLT231RGN
             TO W0001-F-RGNLOC-C.
           MOVE F-DIV-C           IN DCLT231RGN
             TO W0001-F-RGNDIV-C.
           MOVE F-AFM-C           IN DCLT231RGN
             TO W0001-F-RGNAFM-C.
           MOVE F-RGN-X           IN DCLT231RGN
             TO W0001-F-RGNLN-X.

      *
      **=======================================================**
      **         COPYBOOK FOR ERROR HANDLING ROUTINE           **
      **=======================================================**
           EXEC SQL
                INCLUDE C108B900
           END-EXEC.

